home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 326-350 / disk_338 / sastools / wbruise / wbruise.mod < prev    next >
Text File  |  1992-05-06  |  3KB  |  77 lines
  1. (***************************************************************************
  2. *  Programme : WBruise.mod                                                 *
  3. *  Usage     : WBruise                                                     *
  4. *  Version   : V1.31                                                       *
  5. *  Date      : 15.05.1989                                                  *
  6. *  Author    : Jörg Sixt                                                   *
  7. *  Purpose   : your Blitter dies with laughter                             *
  8. *  Language  : Modula-2,AMSoft  PD-Version from Fish 113                   *
  9. *  Bugs      :                                                             *
  10. ***************************************************************************)
  11.  
  12. MODULE WBruise ;
  13.  
  14. FROM SYSTEM     IMPORT ADR ;
  15. FROM Hardtricks IMPORT leftMouseButton ;
  16. FROM Intuition  IMPORT OpenScreen,CloseScreen,NewScreen,ScreenPtr,IntuitionBase,
  17.                        OpenIntuition,ScreenToFront ;
  18. FROM Graphics   IMPORT BltBitMap,SetRast ;
  19.  
  20. CONST  CUTS      = 10 ;
  21.  
  22. VAR  NewScr    : NewScreen ;
  23.      MakePtr,
  24.      ShowPtr,
  25.      HelpPtr,
  26.      WBScr     : ScreenPtr ;
  27.      IBase     : POINTER TO IntuitionBase ;
  28.      i         : INTEGER ;
  29.  
  30. PROCEDURE Frames ;
  31.      VAR j,
  32.          yOffset : INTEGER ;
  33.          planes  : LONGINT ;
  34.  
  35.      BEGIN
  36.           yOffset := (WBScr^.height*(CUTS-i)) DIV (2*CUTS) ;
  37.           SetRast(ADR(MakePtr^.rastPort),0) ;
  38.           FOR j := 0 TO WBScr^.height BY CUTS DO
  39.              planes := BltBitMap ( WBScr^.rastPort.bitMap,0,j,
  40.                                    MakePtr^.rastPort.bitMap,0,yOffset,
  41.                                    MakePtr^.width,i,0C0H,0FFH,00H) ;
  42.              yOffset := yOffset+i ;
  43.           END ;
  44.           ScreenToFront(MakePtr) ;
  45.           HelpPtr := ShowPtr ;
  46.           ShowPtr := MakePtr ;
  47.           MakePtr := HelpPtr ;
  48.      END Frames ;
  49.  
  50. BEGIN
  51.      IBase := OpenIntuition() ;
  52.      WBScr := IBase^.activeScreen ;
  53.  
  54.      WITH NewScr DO
  55.         topEdge   := WBScr^.topEdge ;
  56.         width     := WBScr^.width   ;
  57.         height    := WBScr^.height  ;
  58.         depth     := WBScr^.bitMap.depth ;
  59.         viewModes := WBScr^.viewPort.modes ;
  60.         type      := WBScr^.flags ;
  61.      END ;
  62.  
  63.      ShowPtr := OpenScreen(NewScr) ;
  64.      IF (ShowPtr = NIL) THEN HALT ; END ;
  65.      MakePtr := OpenScreen(NewScr) ;
  66.      IF (ShowPtr = NIL) THEN CloseScreen(ShowPtr) ; HALT ; END ;
  67.  
  68.      WHILE NOT(leftMouseButton()) DO
  69.         ScreenToFront (WBScr) ;
  70.         FOR i := CUTS-1 TO 1 BY -1 DO  Frames ;  END ;
  71.         FOR i := 1      TO CUTS-1  DO  Frames ;  END ;
  72.      END ;
  73.  
  74.      CloseScreen(MakePtr) ;
  75.      CloseScreen(ShowPtr) ;
  76. END WBruise.
  77.